% write_basic_type_pstree.pro

% intended for inclusion in module write_basic_term

:- style_check(-atom).          % allow long atoms


%------------------------------------------------------------------------------
% WRITE A BASIC TYPE AS LaTeX pstree FORMAT
%------------------------------------------------------------------------------

%   write_basic_type_pstree(+Term)
%
%   write latex pstree text describing type of term
%   Term is a basic term represented as a typed prolog term
%
%   FIXME: Currently requires a term to have no empty abstractions or else it
%          will not show the full possible type structure inside the empty abstraction.
%          What it should do is look up the type schema and parse that directly.
%
write_basic_type_pstree(Term) :-
    format('\
\\documentclass[a4paper]{article}
\\usepackage{fullpage}

\\usepackage{pstricks,pst-node,pst-tree,graphics}
\\usepackage{amsmath,amssymb}

\\newcommand{\\ltype}[3]{\\TR[name=#1]{\\small \\ensuremath{#3}}\\tlput{\\tiny \\ensuremath{\\scriptstyle{#2}}}}
\\newcommand{\\rtype}[3]{\\TR[name=#1]{\\small \\ensuremath{#3}}\\trput{\\tiny \\ensuremath{\\scriptstyle{#2}}}}

\\begin{document}

'),
    basic_type_pstree(Term, '',l,root),
    format('\

\\end{document}
'   ).



basic_type_pstree(X::T, Num,Dir,Id) :-
    X =.. [abstraction|Ps],
    !,
    format('\\pstree[nodesep=4pt,levelsep=10ex,arrows=->,linestyle=dotted,linewidth=0.5pt]{\\~wtype{~w}{~w}{',
           [Dir,Id,Num]),
    write_basic_type(latex, X::T),
    format('} }{\n'),
    %
    [P-M|_] = Ps,
    genid(alpha, PId),
    basic_type_pstree(P, 1,l,PId),
    genid(beta, MId),
    basic_type_pstree(M, 2,r,MId),
    %
%    format('\\ncline[arrows=->,linestyle=dotted]{~w}{~w}\n\\taput{\\ensuremath{\\to}}\n', [PId,MId]),
    format('}\n').

basic_type_pstree(X::T, Num,Dir,Id) :-
    X =.. [tuple|Ps],
    !,
    format('\\pstree[nodesep=4pt,levelsep=10ex,arrows=->,linestyle=solid,linewidth=0.25pt]{\\~wtype{~w}{~w}{',
           [Dir,Id,Num]),
    write_basic_type(latex, X::T),
    format('} }{\n'),
    %
    length(Ps,L),
    numlist(1,L,Nums),
    Middle is L / 2,
    forall(
        member(ItemNum,Nums),
        (
         nth1(ItemNum,Ps,P),
         (ItemNum > Middle
         -> ItemDir = r
         ;  ItemDir = l
         ),
         genid(tupleitem, IId),
         basic_type_pstree(P, ItemNum,ItemDir,IId)
        )
    ),
    %
    format('}\n').

basic_type_pstree(X::T, Num,Dir,Id) :-
    X =.. [C|Ps],
    !,
    % constructor
    length(Ps,L),
    (L == 0
    ->  (
         format('\\~wtype{~w}{~w}{', [Dir,Id,Num]),
         write_basic_type(latex, X::T),
         format('}\n')
        )
    ;
        (
         format('\\pstree[nodesep=4pt,levelsep=10ex,arrows=->,linestyle=solid,linewidth=0.5pt]{\\~wtype{~w}{~w}{',
           [Dir,Id,Num]),
         write_basic_type(latex, C::T),
         format('} }{\n'),
         %
         numlist(1,L,Nums),
         Middle is L / 2,
         forall(
            member(ItemNum,Nums),
            (
             nth1(ItemNum,Ps,P),
             (ItemNum > Middle
             -> ItemDir = r
             ;  ItemDir = l
             ),
             genid(parameter, IId),
             basic_type_pstree(P, ItemNum,ItemDir,IId)
            )
         ),
         format('}\n')
        )
    ).
